home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0024_REMAPCGA.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  3KB  |  151 lines
  1. {
  2. After several tricks to redefine Characters in EGA and VGA in this echo,
  3. here is one you can use in CGA mode 4,5,6. You will find an Unit, and a
  4. test Program.
  5. }
  6.  
  7. Unit graftabl;
  8.  
  9. {
  10. released into the public domain
  11. author : Emmanuel ROUSSIN
  12. FIDO   : 2:320/200.21
  13. Email  : roussin@frmug.fr.mugnet.org
  14.  
  15. for using redefined Characters (128 to 255)
  16. in CGA mode 4,5 and 6 Without using GRAFTABL.EXE
  17. }
  18.  
  19. Interface
  20.  
  21. Type
  22.   Tcaractere8 = Array [1..8] of Byte;
  23.   Tgraftabl = Array [128..255] of Tcaractere8;
  24.  
  25. {
  26. if you want to use only one font, define it in this Unit, For example :
  27.  
  28. Const
  29.   the_only_font : Tgraftabl = (
  30.                               (x,x,x,x,x,x,x,x),
  31.                               .
  32.                               .
  33.                               (x,x,x,x,x,x,x,x),
  34.                               (x,x,x,x,x,x,x,x)
  35.                               );
  36.  
  37. Or you can in your main Program :
  38.  
  39. Var
  40.   my_font : Tgraftabl;
  41.  
  42. and define it after
  43. }
  44.  
  45. Var
  46.   seg_graftabl,
  47.   ofs_graftabl : Word;
  48.  
  49. {internal Procedures}
  50.  
  51. Procedure get_graftabl(Var segment, offset : Word);
  52. Procedure put_graftabl(segment, offset : Word);
  53.  
  54. {Procedures to use in your Programs}
  55.  
  56. Procedure init_graftabl;
  57. Procedure use_graftabl(Var aray : Tgraftabl);
  58. Procedure end_graftabl;
  59.  
  60. Implementation
  61.  
  62. Procedure get_graftabl(Var segment, offset : Word);
  63. begin
  64.   segment := memw[0 : $1F * 4 + 2];
  65.   offset  := memw[0 : $1f * 4];
  66. end;
  67.  
  68. Procedure put_graftabl(segment, offset : Word);
  69. begin
  70.   memw[0 : $1f * 4 + 2] := segment;
  71.   memw[0 : $1f * 4] := offset
  72. end;
  73.  
  74. Procedure init_graftabl;
  75. { interrupt 1F is a Pointer to bitmaps For high 128 Chars (8 Bytes per
  76.   Character) defined by GRAFTABL.EXE we save this initial Pointer }
  77. begin
  78.   get_graftabl(seg_graftabl, ofs_graftabl);
  79. end;
  80.  
  81. Procedure use_graftabl(Var aray : Tgraftabl);
  82. { we define a new Pointer : the address of an Array }
  83. begin
  84.   put_graftabl(seg(aray),ofs(aray));
  85. end;
  86.  
  87. Procedure end_graftabl;
  88. { we restore the original Pointer }
  89. begin
  90.   put_graftabl(seg_graftabl,ofs_graftabl);
  91. end;
  92.  
  93. end.
  94.  
  95. Program test;
  96.  
  97. Uses
  98.   Graph3, Crt, graftabl;
  99.  
  100.  
  101. Var
  102.   font    : Tgraftabl;
  103.   i,j,tmp : Byte;
  104.   rid     : Char;
  105.  
  106. begin
  107.   hires;
  108.   init_graftabl;
  109.   fillChar(font,sizeof(font),0);
  110.   use_graftabl(font);
  111.  
  112.   {$F000:$FA6E is the ROM address where the Characters 0 to 127 are defined}
  113.  
  114.   For i := 1 to 26 do
  115.     For j := 0 to 7 do
  116.     begin
  117.       tmp := mem[$F000 : $FA6E + 97 * 8 + (i - 1) * 8 + j] xor $FF;
  118.       tmp := tmp xor $FF;
  119.       tmp := tmp or (tmp div 2);
  120.       font[i + 127, j + 1] := tmp;
  121.       { Char 128 to 153 are redefined }
  122.     end;
  123.  
  124.   For i := 1 to 26 do
  125.     For j := 0 to 7 do
  126.     begin
  127.       tmp := mem[$F000 : $FA6E + 97 * 8 + (i - 1) * 8 + j] or $55;
  128.       font[i + 153, j + 1 ] := tmp;
  129.       { Char 154 to 181 are redefined }
  130.     end;
  131.  
  132.   Writeln('the normal Characters ($61 to $7A) :');
  133.   Writeln;
  134.   For i := $61 to $7A do
  135.     Write(chr(i));
  136.   Writeln; Writeln;
  137.   Writeln('now, these same Characters, but thick :');
  138.   Writeln;
  139.   For i := 128 to 153 do
  140.     Write(chr(i));
  141.   Writeln; Writeln;
  142.   Writeln('the same Characters, but greyed :');
  143.   Writeln;
  144.   For i := 154 to 181 do
  145.     Write(chr(i));
  146.   rid := ReadKey;
  147.   end_graftabl;
  148.   Textmode(co80);
  149. end.
  150.  
  151.